CD ROM Paradise Collection 4/CD ROM Paradise Collection 4 1995 Nov.iso/program/swagg_m.zip/MISC.SWG/0061_Pick Unit; Select Choice.pas

Pascal/Delphi Source File | 1993-11-26 | 13KB | 519 lines

(********************************************************)
(******************** PICK.PAS **************************)
(******* the pick unit; to select menu choice *******)

Unit Pick;

interface

{1} Function ScreenChar : Char; {return the char at the cursor}
{2} Procedure BlockCursor; {give us a block cursor; TP6 & 7 only}
{3} Procedure NormalCursor; {restore cursor to normal; TP6 & 7 only}

{4} Function PickByte(Left, Top, Bottom : Byte) : Byte;
    {return the number of the item chosen as a byte, or
    return ZERO if ESCape is pressed}

{5} Function PickChar(Left, Top, Bottom : Byte) : Char;
    {return the character at the cursor when ENTER is pressed}


{
Notes: for "Pick" functions
  One returns a Byte and the other returns a Char - use one
  or the other;

  Parameters:
  Left   = the left side of the menu list (left side of window+1)
  Top    = the top of the menu list       (top of window+1)
  Bottom = the bottom of the menu list;   (bottom of window-1)
}

implementation

uses
dos,
crt,
keyb;

{-----------------------------------------------------}
Function PickByte(Left,Top,Bottom : byte) : Byte;
{return the number of the item chosen as a byte, or
return ZERO if ESCape is pressed}

Var
x,y,x1,y1 : byte;
ch        : char;
int,total : byte;

begin
    PickByte := 0;              {default to ZERO}
    total := (Bottom - Top)+1;  {total number of items in list}
    x1 := WhereX; y1 := WhereY; {save the original location}

    x := Left; y := Top;
    BlockCursor;         {give us a block cursor}

    GotoXy(x, y);

    int := 1;

    Repeat
       Ch := GetKey;

       Case Ch of
          LeftArrow, UpArrow : {move up}
          begin
             If y = Top then
             begin
               y := Bottom;
               int := total;
             end
             else
             begin
               Dec(y);
               dec(int);
             end;

           GotoXy(x,y);
          end; {leftarrow}

          RightArrow, DownArrow :   {move down}
          begin
             If y = Bottom then
             begin
                y := Top;
                int := 1;
             end
             else
             begin
                Inc(y);
                inc(int);
             end;
             GotoXy(x,y);
          end; {rightarrow}

        PgUp, Home : {go to top of list}
        begin
            y := Top;
            int := 1;
            GotoXy(x,y);
        end;

        PgDn, EndKey :  {go to bottom of list}
        begin
            y := Bottom;
            int := total;
            GotoXy(x,y);
        end;

       #13 : PickByte := int; {return position of choice in the array}
     End; {Case Ch}

    Until (ch = #27) or (ch = #13); {loop until ESCape or ENTER}

    GotoXY(x1,y1);  {return to original location}
    NormalCursor;   {Restore the cursor}
end;
{---------------------------------------------}

Function PickChar(Left, Top,Bottom : byte) : Char;
{return the character at the cursor when ENTER is pressed}

Var
x,y,x1,y1 : byte;
ch    : char;

begin
    PickChar := #27;
    x1 := WhereX; y1 := WhereY;
    x := Left; y := Top;

    BlockCursor;         {give us a block cursor}
    GotoXy(x,y);

    Repeat
       Ch := GetKey;
       Case Ch of
          LeftArrow, UpArrow :
          begin
             If y = Top then y := Bottom else Dec(y);
             GotoXy(x,y);
          end; {leftarrow}

          RightArrow, DownArrow :
          begin
             If y = Bottom then y := Top else Inc(y);
             GotoXy(x,y);
          end; {leftarrow}

        PgUp, Home :
        begin
            y := Top;
            GotoXy(x,y);
        end;

        PgDn, EndKey :
        begin
            y := Bottom;
            GotoXy(x,y);
        end;

       #13 : PickChar := ScreenChar; {return the char under the cursor}
     End; {Case Ch}

    Until (ch = #27) or (ch = #13);
    GotoXY(x1,y1);
    NormalCursor;         {give us a block cursor}

end;
{-----------------------------------------------}

{----------------------------------------}
Function ScreenChar : Char; {return the character at the cursor}
Var
R : Registers;
begin
   Fillchar(R, SizeOf(R), 0);
   R.AH := 8;
   R.BH := 0;
   Intr($10, R);
   ScreenChar := Chr(R.AL);
end;
{--------------------------------------------------}


{---------------------------------}
Procedure NormalCursor; {restore cursor to normal; TP6 & 7 only}
BEGIN
 asm
  mov ah,1
  mov ch,5   { / You will want to fool around with these two}
  mov cl,6   { \ numbers to get the cursor you want}
  int $10
 END;
END;

{--------------------------------}
Procedure BlockCursor; {give us a block cursor; TP6 & 7 only}
BEGIN
 asm
  mov ah,1
  mov ch,5    { / You will want to fool around with these two}
  mov cl,8    { \ numbers to get the cursor you want; (1=big)}
  int $10
 END;
END;
{-------------------------------------}

End.

{----------------- end of PICK.PAS --------------------}




(********************************************************)
(******************** KEYB.PAS **************************)
(******* the keyboard unit; for GetKey() function *******)

Unit Keyb;

Interface

Uses Crt;

Const
        F1  = #187;
        F2  = #188;
        F3  = #189;
        F4  = #190;
        F5  = #191;
        F6  = #192;
        F7  = #193;
        F8  = #194;
        F9  = #195;
        F10 = #196;

        ALTF1  = #232;
        ALTF2  = #233;
        ALTF3  = #234;
        ALTF4  = #235;
        ALTF5  = #236;
        ALTF6  = #237;
        ALTF7  = #238;
        ALTF8  = #239;
        ALTF9  = #240;
        ALTF10 = #241;

        CTRLF1        = #222;
        CTRLF2        = #223;
        CTRLF3        = #224;
        CTRLF4        = #225;
        CTRLF5        = #226;
        CTRLF6        = #227;
        CTRLF7        = #228;
        CTRLF8        = #229;
        CTRLF9        = #230;
        CTRLF10 = #231;

        SHFTF1        = #212;
        SHFTF2        = #213;
        SHFTF3        = #214;
        SHFTF4        = #215;
        SHFTF5        = #216;
        SHFTF6        = #217;
        SHFTF7        = #218;
        SHFTF8        = #219;
        SHFTF9        = #220;
        SHFTF10 = #221;

        UPARROW    = #200;
        RIGHTARROW = #205;
        LEFTARROW  = #203;
        DOWNARROW  = #208;

        HOME           = #199;
        PGUP           = #201;
        ENDKEY           = #207;
        PGDN           = #209;
        INS                      = #210;
        DEL                      = #211;
        TAB                      = #9;
        ESC                      = #27;
        ENTER           = #13;
        SYSREQ           = #183;
        CTRLMINUS  = #31;
        SPACE           = #32;
        CTRL2           = #129;
        CTRL6           = #30;
        BACKSPACE  = #8;
        BS                      = #8; {2 NAMES FOR BACKSPACE}

        CTRLBACKSLASH         = #28;
        CTRLLEFTBRACKET  = #27;
        CTRLRIGHTBRACKET = #29;
        CTRLBACKSPACE         = #127;
        CTRLBS                          = #127;

        ALTA = #158;
        ALTB = #176;
        ALTC = #174;
        ALTD = #160;
        ALTE = #146;
        ALTF = #161;
        ALTG = #162;
        ALTH = #163;
        ALTI = #151;
        ALTJ = #164;
        ALTK = #165;
        ALTL = #166;
        ALTM = #178;
        ALTN = #177;
        ALTO = #152;
        ALTP = #153;
        ALTQ = #144;
        ALTR = #147;
        ALTS = #159;
        ALTT = #148;
        ALTU = #150;
        ALTV = #175;
        ALTW = #145;
        ALTX = #173;
        ALTY = #149;
        ALTZ = #172;

        CTRLA = #1;
        CTRLB = #2;
        CTRLC = #3;
        CTRLD = #4;
        CTRLE = #5;
        CTRLF = #6;
        CTRLG = #7;
        CTRLH = #8;
        CTRLI = #9;
        CTRLJ = #10;
        CTRLK = #11;
        CTRLL = #12;
        CTRLM = #13;
        CTRLN = #14;
        CTRLO = #15;
        CTRLP = #16;
        CTRLQ = #17;
        CTRLR = #18;
        CTRLS = #19;
        CTRLT = #20;
        CTRLU = #21;
        CTRLV = #22;
        CTRLW = #23;
        CTRLX = #24;
        CTRLY = #25;
        CTRLZ = #26;

        ALT1 = #248;
        ALT2 = #249;
        ALT3 = #250;
        ALT4 = #251;
        ALT5 = #252;
        ALT6 = #253;
        ALT7 = #254;
        ALT8 = #255;
        ALT9 = #167;
        ALT0 = #168;

        ALTMINUS = #169;
        ALTEQ         = #170;
        SHIFTTAB = #143;

Function GetKey : Char;
procedure unGetKey(C : char);
procedure FlushKbd;
procedure flushBuffer;

const
    hasPushedChar   : boolean = false;

implementation
var
    pushedChar            : char;


(******************************************************************************
*                                  FlushKbd                                  *
******************************************************************************)
procedure FlushKbd;
var
    C        : char;
begin
    hasPushedChar := False;
    while (KeyPressed) do
         C := GetKey;
end; {flushKbd}

(******************************************************************************
*                                 flushBuffer                                 *
* Same as above, but if key was pushed by eventMgr, know about it !!          *
******************************************************************************)
procedure flushBuffer;
var
   b : boolean;
begin
   b := hasPushedChar;
   flushKbd;
   hasPushedChar := b;
end; {flushBuffer}


(******************************************************************************
*                                  unGetKey                                   *
* UnGetKey will put one character back in the input buffer. Push-back buffer  *
* can contain only one character.                                                                  *
* To avoid problems DO NOT CALL UNGETKEY WITHOUT FIRST CALLING GETKEY. If two *
* characters are pushed, the first is discarded.                                          *
******************************************************************************)
procedure unGetKey;
begin
    hasPushedChar := True;
    pushedChar          := c;
end; {unGetKey}

(******************************************************************************
*                                   GetKey                                   *
******************************************************************************)
function GetKey : Char;
var
        c : Char;
Begin
    if (hasPushedChar) then begin
                GetKey              := pushedChar;
                hasPushedChar := False;
                exit;
    end;
    c := ReadKey;
    if (Ord(c) = 0) then Begin
                c := ReadKey;
                if c in [#128,#129,#130,#131]
                    then c := chr(ord(c) + 39)
                else c := chr(ord(c) + 128); {map to suit keyboard constants}
    End;
    GetKey := c; {return keyboard (my..) code }
End; {getKey}

End.
{--------------- End of KEYB.PAS ---------------}


(********************************************************)
(************************** TEST.PAS ********************)
(*************** to test the PICK unit ******************)
(*************** quit by pressing ESCape ****************)

Program Test;

uses crt,pick;

{--------------- test program -----------------}
const
max = 6;
s : array[1..max] of string[18] =
(
'1. Number One ',
'2. Number Two ',
'3. Number Three ',
'4. Number Four ',
'5. Number Five ',
'6. Number Six ');

var
i  : byte;
x  : byte;
ch : char;
j  : byte;

begin
    clrscr;
    x := 10; {left side of the list}


   {------------------------- test using PickByte() ----------------}
    for i := 1 to max do
    begin            {display the list of menu items}
      j := i+5;      {start from row 6}
      gotoxy(x,j);
      writeln(s[i]);
    end;

    i := j;
    repeat
      {ch := choice(x,1,i);}
      j := pickbyte(x,6,i);

      gotoxy(15,22);
      writeln('You chose ',j);
    until j = 0; {until Escape}

   {------------------------- test using PickChar() ----------------}
    ClrScr;

    ch := 'A';
    for i := 1 to max do
    begin
       s[i][1] := Ch; {change numbers to letters in menu list}
       Inc(Ch);
    end;

    for i := 1 to max do
    begin            {display the list of menu items}
      gotoxy(x,i);   {start from row 1}
      writeln(s[i]);
    end;

    repeat
      ch := PickChar(x,1,i);
      gotoxy(15,22);
      writeln('You chose ',ch);
    until ch = #27;  {until Escape}

end.
{------------------------ end of TEST.PAS ---------------------------}